{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}
module Controllers.Formlets(runSimpleForm) where

import Control.Applicative.Error
import Happstack.Server
import Text.Blaze.Html5.Formlets
import Text.Blaze.Html5(Html, toHtml, form, button, (!))
import qualified Text.Blaze.Html5.Attributes as A
import Control.Monad.Identity
import Session(readSession)

import Pages.MasterPage

-- | Runs a simple form
runSimpleForm :: String -- ^ The form title
                 -> Html5Form Identity a -- ^ The form itself
                 -> (a -> ServerPart Response) -- ^ The successful form submission controller
                 -> ServerPart Response -- ^ The form controller
runSimpleForm title form okHandler = withForm title form showErrorsInline okHandler

-- | A code copy-pasted from somewhere. Need to refactor somehow.
withForm
  :: String
  -> Html5Form Identity a
  -> (Html -> [String] -> ServerPartT IO Response)
  -> (a -> ServerPart Response)
  -> ServerPartT IO Response
withForm _name frm handleErrors handleOk = msum
  [ methodSP GET $ createForm [] frm >>= okHtml
  , withDataFn lookPairs $ \d ->
      methodSP POST $ handleOk' $ simple d
  ]
  where
    handleOk' d = do
      let (extractor, _html, _) = runFormState d frm
      let v = runIdentity extractor
      case v of
        Failure faults -> do
          f <- createForm d frm
          handleErrors f faults
        Success s      -> handleOk s
    simple d = [(k, Left v) | (k, Right v) <- d]


-- | A simple error handler, showing the form submission errors beside the form
showErrorsInline :: (FilterMonad Response m, Functor m, HasRqData m, MonadPlus m) => Html -> [String] -> m Response
showErrorsInline renderedForm errors =
  okHtml $ toHtml (show errors) >> renderedForm

-- | Creates an HTML-content for the form and adds a "Submit" button to it
createForm :: Monad m => Env -> Html5Form m a -> ServerPartT IO Html
createForm env frm = do
  let (_extractor, xml, _endState) = runFormState env frm
  return $ (form ! A.method "POST") $ do
                    xml
                    button ! A.type_ "submit" $ "Submit"

-- | Wraps the content into the master page and converts it to an HTTP response
okHtml :: (FilterMonad Response m, Functor m, HasRqData m, MonadPlus m) => Html -> m Response
okHtml content = do
    session <- readSession
    ok $ toResponse $ masterPage session "Testing forms" $ content
